home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacHack 1994
/
MacHack 1994.toast
/
MacHack™94
/
Talks & Papers
/
Timothy Knox
/
Pocket6.3
/
Extensions
/
fvgFloatingPoint
next >
Wrap
Text File
|
1994-06-24
|
2KB
|
60 lines
\ FVG Compliance 10 May 1993
\ This file brings Pocket Forth's floating point math into
\ compliance with the ad hoc FVG floating point standard.
\ Numeric input is an exception. As allways any number with
\ a decimal point is interpreted as a floating point number.
\ If you want a double number, use the sequence: 123456x f>d.
\ The standard calls for fp numbers to contain an E. This is
\ supported but not required by Pocket Forth.
0 28 +md !
variable (PLACES) 4 (places) ! \ decimal places for f.
\ utility words
: fflag fcompare >r fdrop fdrop r> ;
: f?nip IF fswap THEN fdrop ;
\ words to be redefined
: (fnumber) fnumber ;
: (f.) f. ;
: (fix) fix ;
\ Words supported by the standard follow:
: FACOS ( f -- acos[f] )
fdup 1.0 fswap f- fswap 1.0 f+ f/ fsqrt fatn 2.0 f* ;
: FASIN ( f -- asin[f] ) ( from Apple Numerics Manual, 2nd ed. )
fdup fabs 1.16415321827e-10 fcompare >r fdrop r> 0> IF
fdup 0.5 fflag 0> IF
1. fswap f- fdup 2. f* fswap fdup f* f- ELSE
1. fswap fdup f* f- THEN
fsqrt f/ fatn ELSE
fdrop THEN ;
: PI ( -- f.pi ) 0.0 facos 2.0 f* ;
: FLOG ( f -- logf ) fln 10. fln f/ ;
: FALOG ( f -- 10^f ) 10. fswap f^ ;
: FALN ( f -- e^f ) fexp ;
: F** ( f1 f2 -- f1^f2 ) f^ ;
: FMAX ( f1 f2 -- fmax ) fcompare 0> f?nip ;
: FMIN ( f1 f2 -- fmin ) fcompare 0< f?nip ;
: F= ( f1 f2 -- flag ) fflag 0= ;
: F< ( f1 f2 -- flag ) fflag 0< ;
: F> ( f1 f2 -- flag ) fflag 0> ;
: F0= ( f -- flag ) 0. f= ;
: F0< ( f -- flag ) 0. f< ;
: F0> ( f -- flag ) 0. f> ;
: FOVER ( f1 f2 --f1 f2 f1 ) 2 fpick ;
: FROT ( f1 f2 f3 -- f2 f3 f1 ) 3 froll ;
: FLOAT ( d -- f ) d>f ;
: INT ( f -- d ) f>d ;
: PLACES ( n -- ) (places) ! ;
: E. ( f -- ) 18 sci f. ;
\ redefined words
: FNUMBER ( addr -- f ) >abs (fnumber) ; ( new def'n for FNUMBER )
: F. ( f -- ) (places) @ fix (f.) ; ( new definition for F. )
: FIX ( f -- d ) .5 f+ fint f>d ; ( new definition for FIX )
-1 28 +md !